MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 07 - 1991/07.05 May 91/Math Parser ƒ/ParserProcs/ParserOps

Text File | 1990-10-04 | 5.7 KB | 361 lines | [TEXT/PJMM]

unit ParserOps;


interface


    uses

        ParserGlobals;

    procedure setdecimal;

    procedure readtfile;

    procedure createtfile (var savename: stringsize);

    procedure listtfiles;

    procedure listtfile (var savename: stringsize);

    procedure clearscreen (var line: str255);

    procedure readvariables;

    procedure listvariables;

    procedure deletevariable (var savename: stringsize);

    procedure storevariables;


implementation


    procedure setdecimal;

    begin
        writeln('set number of decimal places to');
        write(blank);
        readln(decplace);
        decplaceplus10 := decplace + 10;
    end;


    procedure readtfile;

        var
            i: integer;

    begin

        for i := 1 to maxnumberfiles do
            tfilename^^[i] := '';

        numfilename := 'numfiles';
        open(numfile, numfilename);

        reset(numfile);
        if not eof(numfile) then
            readln(numfile, numberfiles);
        if numberfiles <> 0 then
            for i := 1 to numberfiles do
                readln(numfile, tfilename^^[i]);
        close(numfile);

    end;


    procedure createtfile;

        label
            1;

        var
            i, k: integer;
            line: str255;

    begin

        for i := 1 to numberfiles do
            if tfilename^^[i] = savename then
                begin
                    k := i;
                    goto 1;
                end;

        numberfiles := numberfiles + 1;
        k := numberfiles;
        tfilename^^[k] := savename;

1:
        if not tfileopen^^[k] then
            begin
                open(tfile^^[k], tfilename^^[k]);
                tfileopen^^[k] := true;
            end;
        rewrite(tfile^^[k]);

        repeat
            write(blank);
            readln(line);
            if length(line) <> 0 then
                writeln(tfile^^[k], line);
        until length(line) = 0;

        close(tfile^^[k]);
        tfileopen^^[k] := false;

        open(numfile, numfilename);
        rewrite(numfile);

        writeln(numfile, numberfiles);

        for i := 1 to numberfiles do
            writeln(numfile, tfilename^^[i]);

        close(numfile);

    end;



    procedure listtfiles;

        var
            i, j, k: integer;
            flag: hdlflagtype;

    begin

        flag := hdlflagtype(NewHandle(SizeOf(flagtype)));

        for i := 1 to numberfiles do
            flag^^[i] := true;

        for i := 1 to numberfiles do
            begin
                j := numberfiles + 1 - i;
                for k := 1 to j - 1 do
                    begin
                        if (tfilename^^[k] = tfilename^^[j]) then
                            flag^^[k] := false;
                    end;
            end;

        for i := 1 to numberfiles do
            if flag^^[i] then
                writeln(tfilename^^[i]);

        DisposHandle(handle(flag));

    end;


    procedure listtfile;

        label
            1;

        var
            i, k: integer;
            line: str255;

    begin

        for i := 1 to numberfiles do
            if tfilename^^[i] = savename then
                begin
                    k := i;
                    if not tfileopen^^[k] then
                        begin
                            open(tfile^^[k], tfilename^^[k]);
                            tfileopen^^[k] := true;
                        end;
                    reset(tfile^^[k]);
1:
                    if not eof(tfile^^[k]) then
                        begin
                            readln(tfile^^[k], line);
                            writeln(line);
                            goto 1;
                        end;
                    close(tfile^^[k]);
                    tfileopen^^[k] := false;
                end;

    end;


    procedure ClearScreen;


        var
            m, place: integer;
            removeblanks: boolean;
            tfile: hdltextfilearray;
            tfilename: hdlstringarray0;

    begin

        removeblanks := true;

        place := pos(blank, line);
        while place <> 0 do
            begin
                delete(line, place, 1);
                place := pos(blank, line);
            end;

        m := pos('cls', line);
        delete(line, m, 4);
        if line <> '' then
            writeln('cls is a reserved word for clearing the screen');
        if line = '' then
            rewrite(output);
    end;

    procedure readvariables;

        var
            i: integer;

    begin

        for i := 1 to maxnumberofstrings do
            begin
                strvar^^[i] := '';
                strvartokentype^^[i] := '';
                val^^[i] := 0;
            end;

        open(varfile, varfilename);
        reset(varfile);
        numvariables := 0;

        while not eof(varfile) do
            begin
                numvariables := numvariables + 1;
                readln(varfile, strvar^^[numvariables]);
                readln(varfile, strvartokentype^^[numvariables]);
                readln(varfile, val^^[numvariables]);
            end;


    end;


    procedure listvariables;

        var
            i, j, k, m: integer;
            varname: stringsize;
            flag: hdlflagtype;

    begin

        flag := hdlflagtype(NewHandle(SizeOf(flagtype)));

        if numvariables > 0 then
            for i := 1 to numvariables do
                flag^^[i] := true;
        if numvariables > 0 then
            for i := 1 to numvariables do
                begin
                    j := numvariables + 1 - i;
                    for k := 1 to j - 1 do
                        begin
                            if (strvar^^[k] = strvar^^[j]) then
                                flag^^[k] := false;
                        end;
                end;
        if numvariables > 0 then
            for i := 1 to numvariables do
                if (strvartokentype^^[i] = 'real') and flag^^[i] then
                    writeln(strvar^^[i], '   ', val^^[i] : decplaceplus10 : decplace);

        DisposHandle(handle(flag));

    end;


    procedure deletevariable;

        label
            3;

        var
            i, k: integer;

    begin

        for i := 1 to numvariables do
            if strvar^^[i] = savename then
                begin
                    if i = numvariables then
                        goto 3;
                    for k := i to numvariables - 1 do
                        begin
                            strvar^^[k] := strvar^^[k + 1];
                            val^^[k] := val^^[k + 1];
                            strvartokentype^^[k] := 'real';
                        end;
                    goto 3;
                end;
3:
        numvariables := numvariables - 1;


    end;



    procedure storevariables;

        var
            i, j, k, mtot: integer;
            flag: hdlflagtype;

    begin

        decplace := 20;
        decplaceplus10 := decplace + 10;

        flag := hdlflagtype(NewHandle(SizeOf(flagtype)));

        rewrite(varfile);
        for i := 1 to numvariables do
            flag^^[i] := false;
        for i := 1 to numvariables do
            begin
                k := numvariables + 1 - i;
                if flag^^[k] = false then
                    for j := 1 to k - 1 do
                        if (strvar^^[j] = strvar^^[k]) then
                            flag^^[j] := true;
            end;

        mtot := 0;
        for i := 1 to numvariables do
            if not flag^^[i] then
                begin
                    mtot := mtot + 1;
                    strvar^^[mtot] := strvar^^[i];
                    strvartokentype^^[mtot] := strvartokentype^^[i];
                    val^^[mtot] := val^^[i];
                end;
        numvariables := mtot;

        for i := 1 to numvariables do
            begin
                writeln(varfile, strvar^^[i]);
                writeln(varfile, strvartokentype^^[i]);
                writeln(varfile, val^^[i] : decplaceplus10 : decplace);
            end;

        DisposHandle(handle(flag));

    end;


end.